Add Utility.OsString, with a special case for length.
import Utility.OsPath
import Utility.Exception
import Utility.Monad
-import Utility.FileSystemEncoding
import qualified Utility.RawFilePath as R
dirCruft :: R.RawFilePath -> Bool
import Data.Maybe
import Data.List
import Network.BSD
-import System.FilePath
import Control.Applicative
import Prelude
-type PidLockFile = RawFilePath
+type PidLockFile = OsPath
data LockHandle
= LockHandle PidLockFile FileStatus SideLockHandle
| ParentLocked
-type SideLockHandle = Maybe (RawFilePath, Posix.LockHandle)
+type SideLockHandle = Maybe (OsPath, Posix.LockHandle)
data PidLock = PidLock
{ lockingPid :: ProcessID
readPidLock :: PidLockFile -> IO (Maybe PidLock)
readPidLock lockfile = (readish =<<)
- <$> catchMaybeIO (readFile (fromRawFilePath lockfile))
+ <$> catchMaybeIO (readFile (fromOsPath lockfile))
-- To avoid races when taking over a stale pid lock, a side lock is used.
-- This is a regular posix exclusive lock.
-- to take the side lock will only succeed once the file is
-- deleted, and so will be able to immediately see that it's taken
-- a stale lock.
- _ <- tryIO $ removeFile (fromRawFilePath f)
+ _ <- tryIO $ removeFile f
Posix.dropLock h
-- The side lock is put in /dev/shm. This will work on most any
-- Linux system, even if its whole root filesystem doesn't support posix
-- locks. /tmp is used as a fallback.
-sideLockFile :: PidLockFile -> IO RawFilePath
+sideLockFile :: PidLockFile -> IO OsPath
sideLockFile lockfile = do
- f <- fromRawFilePath <$> absPath lockfile
- let base = intercalate "_" (splitDirectories (makeRelative "/" f))
+ f <- absPath lockfile
+ let base = intercalate "_" $ map fromOsPath $
+ splitDirectories $ makeRelative (literalOsPath "/") f
let shortbase = reverse $ take 32 $ reverse base
let md5sum = if base == shortbase
then ""
- else toRawFilePath $ show (md5 (encodeBL base))
- dir <- ifM (doesDirectoryExist "/dev/shm")
- ( return "/dev/shm"
- , return "/tmp"
+ else show (md5 (encodeBL base))
+ dir <- ifM (doesDirectoryExist (literalOsPath "/dev/shm"))
+ ( return (literalOsPath "/dev/shm")
+ , return (literalOsPath "/tmp")
)
- return $ dir P.</> md5sum <> toRawFilePath shortbase <> ".lck"
+ return $ dir </> toOsPath md5sum <> toOsPath shortbase <> literalOsPath ".lck"
-- | Tries to take a lock; does not block when the lock is already held.
--
go abslockfile sidelock = do
(tmp, h) <- openTmpFileIn
(toOsPath (P.takeDirectory abslockfile))
- (toOsPath "locktmp")
+ (literalOsPath "locktmp")
let tmp' = fromOsPath tmp
setFileMode tmp' (combineModes readModes)
hPutStr h . show =<< mkPidLock
--- /dev/null
+{- OsString manipulation. Or ByteString when not built with OsString.
+ - Import qualified.
+ -
+ - Copyright 2025 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.OsString (
+ module X,
+ length
+) where
+
+#ifdef WITH_OSPATH
+import System.OsString as X hiding (length)
+import qualified System.OsString
+import qualified Data.ByteString as B
+import Utility.OsPath
+
+{- Avoid System.OsString.length, which returns the number of code points on
+ - windows. This is the number of bytes. -}
+length :: System.OsString.OsString -> Int
+length = B.length . fromOsString
+#else
+import Data.ByteString as X hiding (length)
+import Data.ByteString (length)
+#endif
import Utility.SystemDirectory
import Utility.Exception
import Utility.OsPath
+import qualified Utility.OsString as OS
#ifdef mingw32_HOST_OS
import Data.Char
upFrom dir
| length dirs < 2 = Nothing
| otherwise = Just $ joinDrive drive $ toOsPath $
- B.intercalate (B.singleton pathSeparator) $ init dirs
+ B.intercalate (B.singleton PB.pathSeparator) $ init dirs
where
-- on Unix, the drive will be "/" when the dir is absolute,
-- otherwise ""
(drive, path) = splitDrive dir
- dirs = filter (not . B.null) $ B.splitWith PB.isPathSeparator $ fromOsPath path
+ dirs = filter (not . OS.null) $ OS.splitWith isPathSeparator path
{- Checks if the first path is, or could be said to contain the second.
- For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
- a'' is a prefix of b', so all that needs to be done is drop
- that prefix, and check if the next path component is ".."
-}
- avoiddotdotb = nodotdot $ B.drop (B.length a'') $ fromOsPath b'
+ avoiddotdotb = nodotdot $ OS.drop (OS.length a'') b'
nodotdot p = all (not . isdotdot) (splitPath p)
| f == "." = False
| f == ".." = False
| f == "" = False
- | otherwise = "." `B.isPrefixOf` f || dotfile (takeDirectory file)
+ | otherwise = "." `OS.isPrefixOf` f || dotfile (takeDirectory file)
where
f = takeFileName file
splitShortExtensions' maxextension = go []
where
go c f
- | len > 0 && len <= maxextension && not (B.null base) =
- go (ext:c) base
+ | len > 0 && len <= maxextension && not (OS.null base) =
+ go (fromOsPath ext:c) base
| otherwise = (f, c)
where
(base, ext) = splitExtension f
- len = B.length ext
+ len = OS.length ext
{- This requires both paths to be absolute and normalized.
-
import Utility.Path
import Utility.UserInfo
-import Utility.FileSystemEncoding
-import qualified Utility.RawFilePath as R
+import Utility.OsPath
+import Utility.SystemDirectory
{- Makes a path absolute.
-
- Does not attempt to deal with edge cases or ensure security with
- untrusted inputs.
-}
-absPathFrom :: RawFilePath -> RawFilePath -> RawFilePath
+absPathFrom :: OsPath -> OsPath -> OsPath
absPathFrom dir path = simplifyPath (combine dir path)
{- Converts a filename into an absolute path.
-
- Unlike Directory.canonicalizePath, this does not require the path
- already exists. -}
-absPath :: RawFilePath -> IO RawFilePath
+absPath :: OsPath -> IO OsPath
absPath file
-- Avoid unnecessarily getting the current directory when the path
-- is already absolute. absPathFrom uses simplifyPath
-- so also used here for consistency.
| isAbsolute file = return $ simplifyPath file
| otherwise = do
- cwd <- R.getCurrentDirectory
+ cwd <- getCurrentDirectory
return $ absPathFrom cwd file
{- Constructs the minimal relative path from the CWD to a file.
- relPathCwdToFile "/tmp/foo/bar" == ""
- relPathCwdToFile "../bar/baz" == "baz"
-}
-relPathCwdToFile :: RawFilePath -> IO RawFilePath
+relPathCwdToFile :: OsPath -> IO OsPath
relPathCwdToFile f
-- Optimisation: Avoid doing any IO when the path is relative
-- and does not contain any ".." component.
- | isRelative f && not (".." `B.isInfixOf` f) = return f
+ | isRelative f && not (".." `B.isInfixOf` fromOsPath f) = return f
| otherwise = do
- c <- R.getCurrentDirectory
+ c <- getCurrentDirectory
relPathDirToFile c f
{- Constructs a minimal relative path from a directory to a file. -}
-relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath
+relPathDirToFile :: OsPath -> OsPath -> IO OsPath
relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
{- Converts paths in the home directory to use ~/ -}
-relHome :: FilePath -> IO String
+relHome :: OsPath -> IO String
relHome path = do
- let path' = toRawFilePath path
- home <- toRawFilePath <$> myHomeDir
- return $ if dirContains home path'
- then fromRawFilePath ("~/" <> relPathDirToFileAbs home path')
- else path
+ home <- toOsPath <$> myHomeDir
+ return $ if dirContains home path
+ then fromOsPath (literalOsPath "~/" <> relPathDirToFileAbs home path)
+ else fromOsPath path
Utility.OptParse
Utility.OSX
Utility.OsPath
+ Utility.OsString
Utility.PID
Utility.PartialPrelude
Utility.Path
projects / git-annex.git / commitdiff